home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tk8.0 / mac / tkMacDialog.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-15  |  24.0 KB  |  940 lines  |  [TEXT/CWIE]
  1. /*
  2.  * tkMacDialog.c --
  3.  *
  4.  *    Contains the Mac implementation of the common dialog boxes.
  5.  *
  6.  * Copyright (c) 1996 Sun Microsystems, Inc.
  7.  *
  8.  * See the file "license.terms" for information on usage and redistribution
  9.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  10.  *
  11.  * SCCS: @(#) tkMacDialog.c 1.12 96/12/03 11:15:12
  12.  *
  13.  */
  14.  
  15. #include <Gestalt.h>
  16. #include <Aliases.h>
  17. #include <Errors.h>
  18. #include <Strings.h>
  19. #include <MoreFiles.h>
  20. #include <MoreFilesExtras.h>
  21. #include <StandardFile.h>
  22. #include <ColorPicker.h>
  23. #include <Lowmem.h>
  24. #include "tkPort.h"
  25. #include "tkInt.h"
  26. #include "tclMacInt.h"
  27. #include "tkFileFilter.h"
  28.  
  29. /*
  30.  * The following are ID's for resources that are defined in tkMacResource.r
  31.  */
  32. #define OPEN_BOX        130
  33. #define OPEN_POPUP      131
  34. #define OPEN_MENU       132
  35. #define OPEN_POPUP_ITEM 10
  36.  
  37. #define SAVE_FILE    0
  38. #define OPEN_FILE    1
  39.  
  40. #define MATCHED        0
  41. #define UNMATCHED    1
  42.  
  43. /*
  44.  * The following structure is used in the GetFileName() function. It stored
  45.  * information about the file dialog and the file filters.
  46.  */
  47. typedef struct _OpenFileData {
  48.     Tcl_Interp * interp;
  49.     char * initialFile;            /* default file to appear in the
  50.                      * save dialog */
  51.     char * defExt;            /* default extension (not used on the
  52.                      * Mac) */
  53.     FileFilterList fl;            /* List of file filters. */
  54.     SInt16 curType;            /* The filetype currently being
  55.                      * listed */
  56.     int isOpen;                /* True if this is an Open dialog,
  57.                      * false if it is a Save dialog. */
  58.     MenuHandle menu;            /* Handle of the menu in the popup*/
  59.     short dialogId;            /* resource ID of the dialog */
  60.     int popupId;            /* resource ID of the popup */
  61.     short popupItem;            /* item number of the popup in the
  62.                      * dialog */
  63.     int usePopup;            /* True if we show the popup menu (this
  64.                          * is an open operation and the
  65.                      * -filetypes option is set)
  66.                          */
  67. } OpenFileData;
  68.  
  69. static pascal Boolean    FileFilterProc _ANSI_ARGS_((CInfoPBPtr pb,
  70.                 void *myData));
  71. static int         GetFileName _ANSI_ARGS_ ((
  72.                 ClientData clientData, Tcl_Interp *interp,
  73.                     int argc, char **argv, int isOpen ));
  74. static Boolean        MatchOneType _ANSI_ARGS_((CInfoPBPtr pb,
  75.                 OpenFileData * myDataPtr, FileFilter * filterPtr));
  76. static pascal short     OpenHookProc _ANSI_ARGS_((short item,
  77.                 DialogPtr theDialog, OpenFileData * myDataPtr));
  78. static int         ParseFileDlgArgs _ANSI_ARGS_ ((Tcl_Interp * interp,
  79.                 OpenFileData * myDataPtr, int argc, char ** argv,
  80.                 int isOpen));
  81.  
  82. /*
  83.  * Filter and hook functions used by the tk_getOpenFile and tk_getSaveFile
  84.  * commands.
  85.  */
  86.  
  87. static FileFilterYDUPP openFilter = NULL;
  88. static DlgHookYDUPP openHook = NULL;
  89. static DlgHookYDUPP saveHook = NULL;
  90.   
  91.  
  92. /*
  93.  *----------------------------------------------------------------------
  94.  *
  95.  * EvalArgv --
  96.  *
  97.  *    Invokes the Tcl procedure with the arguments. argv[0] is set by
  98.  *    the caller of this function. It may be different than cmdName.
  99.  *    The TCL command will see argv[0], not cmdName, as its name if it
  100.  *    invokes [lindex [info level 0] 0]
  101.  *
  102.  * Results:
  103.  *    TCL_ERROR if the command does not exist and cannot be autoloaded.
  104.  *    Otherwise, return the result of the evaluation of the command.
  105.  *
  106.  * Side effects:
  107.  *    The command may be autoloaded.
  108.  *
  109.  *----------------------------------------------------------------------
  110.  */
  111.  
  112. static int
  113. EvalArgv(
  114.     Tcl_Interp *interp,        /* Current interpreter. */
  115.     char * cmdName,        /* Name of the TCL command to call */
  116.     int argc,            /* Number of arguments. */
  117.     char **argv)        /* Argument strings. */
  118. {
  119.     Tcl_CmdInfo cmdInfo;
  120.  
  121.     if (!Tcl_GetCommandInfo(interp, cmdName, &cmdInfo)) {
  122.     char * cmdArgv[2];
  123.  
  124.     /*
  125.      * This comand is not in the interpreter yet -- looks like we
  126.      * have to auto-load it
  127.      */
  128.     if (!Tcl_GetCommandInfo(interp, "auto_load", &cmdInfo)) {
  129.         Tcl_ResetResult(interp);
  130.         Tcl_AppendResult(interp, "cannot execute command \"auto_load\"",
  131.         NULL);
  132.         return TCL_ERROR;
  133.     }
  134.  
  135.     cmdArgv[0] = "auto_load";
  136.     cmdArgv[1] = cmdName;
  137.  
  138.     if ((*cmdInfo.proc)(cmdInfo.clientData, interp, 2, cmdArgv)!= TCL_OK){ 
  139.         return TCL_ERROR;
  140.     }
  141.  
  142.     if (!Tcl_GetCommandInfo(interp, cmdName, &cmdInfo)) {
  143.         Tcl_ResetResult(interp);
  144.         Tcl_AppendResult(interp, "cannot auto-load command \"",
  145.         cmdName, "\"",NULL);
  146.         return TCL_ERROR;
  147.     }
  148.     }
  149.  
  150.     return (*cmdInfo.proc)(cmdInfo.clientData, interp, argc, argv);
  151. }
  152.  
  153. /*
  154.  *----------------------------------------------------------------------
  155.  *
  156.  * Tk_ChooseColorCmd --
  157.  *
  158.  *    This procedure implements the color dialog box for the Mac
  159.  *    platform. See the user documentation for details on what it
  160.  *    does.
  161.  *
  162.  * Results:
  163.  *      A standard Tcl result.
  164.  *
  165.  * Side effects:
  166.  *      See the user documentation.
  167.  *
  168.  *----------------------------------------------------------------------
  169.  */
  170.  
  171. int
  172. Tk_ChooseColorCmd(
  173.     ClientData clientData,    /* Main window associated with interpreter. */
  174.     Tcl_Interp *interp,        /* Current interpreter. */
  175.     int argc,            /* Number of arguments. */
  176.     char **argv)        /* Argument strings. */
  177. {
  178.     Tk_Window parent = Tk_MainWindow(interp);
  179.     char * colorStr = NULL;
  180.     XColor * colorPtr = NULL;
  181.     char * title = "Choose a color:";
  182.     int i, version;
  183.     long response = 0;
  184.     OSErr err = noErr;
  185.     char buff[40];
  186.     static RGBColor in;
  187.     static inited = 0;
  188.  
  189.     /*
  190.      * Use the gestalt manager to determine how to bring
  191.      * up the color picker.  If versin 2.0 isn't available
  192.      * we can assume version 1.0 is available as it comes with
  193.      * Color Quickdraw which Tk requires to run at all.
  194.      */
  195.      
  196.     err = Gestalt(gestaltColorPicker, &response); 
  197.     if ((err == noErr) || (response == 0x0200L)) {
  198.         version = 2;
  199.     } else {
  200.         version = 1;
  201.     }
  202.  
  203.     for (i=1; i<argc; i+=2) {
  204.         int v = i+1;
  205.     int len = strlen(argv[i]);
  206.  
  207.         if (strncmp(argv[i], "-initialcolor", len)==0) {
  208.         if (v==argc) {goto arg_missing;}
  209.  
  210.         colorStr = argv[v];
  211.     } else if (strncmp(argv[i], "-parent", len)==0) {
  212.         if (v==argc) {goto arg_missing;}
  213.  
  214.         parent=Tk_NameToWindow(interp, argv[v], Tk_MainWindow(interp));
  215.         if (parent == NULL) {
  216.         return TCL_ERROR;
  217.         }
  218.     } else if (strncmp(argv[i], "-title", len)==0) {
  219.         if (v==argc) {goto arg_missing;}
  220.  
  221.         title = argv[v];
  222.     } else {
  223.             Tcl_AppendResult(interp, "unknown option \"", 
  224.             argv[i], "\", must be -initialcolor, -parent or -title",
  225.             NULL);
  226.         return TCL_ERROR;
  227.     }
  228.     }
  229.  
  230.     if (colorStr) {
  231.         colorPtr = Tk_GetColor(interp, parent, colorStr);
  232.         if (colorPtr == NULL) {
  233.             return TCL_ERROR;
  234.         }
  235.     }
  236.  
  237.     if (!inited) {
  238.         inited = 1;
  239.         in.red = 0xffff;
  240.         in.green = 0xffff;
  241.         in.blue = 0xffff;
  242.     }
  243.     if (colorPtr) {
  244.         in.red   = colorPtr->red;
  245.         in.green = colorPtr->green;
  246.         in.blue  = colorPtr->blue;
  247.     }
  248.         
  249.     if (version == 1) {
  250.         /*
  251.          * Use version 1.0 of the color picker
  252.          */
  253.         
  254.         RGBColor out;
  255.         Str255 prompt;
  256.         Point point = {-1, -1};
  257.         
  258.         prompt[0] = strlen(title);
  259.         strncpy((char*) prompt+1, title, 255);
  260.         
  261.         if (GetColor(point, prompt, &in, &out)) {
  262.             /*
  263.              * user selected a color
  264.              */
  265.             sprintf(buff, "#%02x%02x%02x", out.red >> 8, out.green >> 8,
  266.                 out.blue >> 8);
  267.             Tcl_SetResult(interp, buff, TCL_VOLATILE);
  268.  
  269.             /*
  270.              * Save it for the next time
  271.              */
  272.             in.red   = out.red;
  273.             in.green = out.green;
  274.             in.blue  = out.blue;
  275.         } else {
  276.             Tcl_ResetResult(interp);
  277.         }
  278.     } else {
  279.         /*
  280.          * Version 2.0 of the color picker is available. Let's use it
  281.          */
  282.     ColorPickerInfo cpinfo;
  283.  
  284.         cpinfo.theColor.profile = 0L;
  285.         cpinfo.theColor.color.rgb.red   = in.red;
  286.         cpinfo.theColor.color.rgb.green = in.green;
  287.         cpinfo.theColor.color.rgb.blue  = in.blue;
  288.         cpinfo.dstProfile = 0L;
  289.         cpinfo.flags = CanModifyPalette | CanAnimatePalette;
  290.         cpinfo.placeWhere = kDeepestColorScreen;
  291.         cpinfo.pickerType = 0L;
  292.         cpinfo.eventProc = NULL;
  293.         cpinfo.colorProc = NULL;
  294.         cpinfo.colorProcData = NULL;
  295.  
  296.         cpinfo.prompt[0] = strlen(title);
  297.         strncpy((char*)cpinfo.prompt+1, title, 255);
  298.         
  299.         if ((PickColor(&cpinfo) == noErr) && cpinfo.newColorChosen) {
  300.             sprintf(buff, "#%02x%02x%02x",
  301.         cpinfo.theColor.color.rgb.red   >> 8, 
  302.                 cpinfo.theColor.color.rgb.green >> 8,
  303.         cpinfo.theColor.color.rgb.blue  >> 8);
  304.             Tcl_SetResult(interp, buff, TCL_VOLATILE);
  305.             
  306.             in.blue  = cpinfo.theColor.color.rgb.red;
  307.             in.green = cpinfo.theColor.color.rgb.green;
  308.             in.blue  = cpinfo.theColor.color.rgb.blue;
  309.           } else {
  310.             Tcl_ResetResult(interp);
  311.         }
  312.     }
  313.  
  314.     if (colorPtr) {
  315.     Tk_FreeColor(colorPtr);
  316.     }
  317.  
  318.     return TCL_OK;
  319.  
  320.   arg_missing:
  321.     Tcl_AppendResult(interp, "value for \"", argv[argc-1], "\" missing",
  322.     NULL);
  323.     return TCL_ERROR;
  324. }
  325.  
  326. /*
  327.  *----------------------------------------------------------------------
  328.  *
  329.  * Tk_GetOpenFileCmd --
  330.  *
  331.  *    This procedure implements the "open file" dialog box for the
  332.  *    Mac platform. See the user documentation for details on what
  333.  *    it does.
  334.  *
  335.  * Results:
  336.  *      A standard Tcl result.
  337.  *
  338.  * Side effects:
  339.  *    See user documentation.
  340.  *----------------------------------------------------------------------
  341.  */
  342.  
  343. int
  344. Tk_GetOpenFileCmd(
  345.     ClientData clientData,    /* Main window associated with interpreter. */
  346.     Tcl_Interp *interp,        /* Current interpreter. */
  347.     int argc,            /* Number of arguments. */
  348.     char **argv)        /* Argument strings. */
  349. {
  350.     return GetFileName(clientData, interp, argc, argv, OPEN_FILE);
  351. }
  352.  
  353. /*
  354.  *----------------------------------------------------------------------
  355.  *
  356.  * Tk_GetSaveFileCmd --
  357.  *
  358.  *    Same as Tk_GetOpenFileCmd but opens a "save file" dialog box
  359.  *    instead
  360.  *
  361.  * Results:
  362.  *      A standard Tcl result.
  363.  *
  364.  * Side effects:
  365.  *    See user documentation.
  366.  *----------------------------------------------------------------------
  367.  */
  368.  
  369. int
  370. Tk_GetSaveFileCmd(
  371.     ClientData clientData,    /* Main window associated with interpreter. */
  372.     Tcl_Interp *interp,        /* Current interpreter. */
  373.     int argc,            /* Number of arguments. */
  374.     char **argv)        /* Argument strings. */
  375. {
  376.     return GetFileName(clientData, interp, argc, argv, SAVE_FILE);
  377. }
  378.  
  379. /*
  380.  *----------------------------------------------------------------------
  381.  *
  382.  * GetFileName --
  383.  *
  384.  *    Calls the Mac file dialog functions for the user to choose a
  385.  *    file to or save.
  386.  *
  387.  * Results:
  388.  *    A standard Tcl result.
  389.  *
  390.  * Side effects:
  391.  *    If the user selects a file, the native pathname of the file
  392.  *    is returned in interp->result. Otherwise an empty string
  393.  *    is returned in interp->result.
  394.  *
  395.  *----------------------------------------------------------------------
  396.  */
  397.  
  398. static int
  399. GetFileName(
  400.     ClientData clientData,    /* Main window associated with interpreter. */
  401.     Tcl_Interp *interp,        /* Current interpreter. */
  402.     int argc,            /* Number of arguments. */
  403.     char **argv,        /* Argument strings. */
  404.     int isOpen)            /* true if we should call GetOpenFileName(),
  405.                  * false if we should call GetSaveFileName() */
  406. {
  407.     int code = TCL_OK;
  408.     int i;
  409.     OpenFileData myData, *myDataPtr;
  410.     StandardFileReply reply;
  411.     Point mypoint;
  412.     Str255 str;
  413.  
  414.     myDataPtr = &myData;
  415.  
  416.     if (openFilter == NULL) {
  417.     openFilter = NewFileFilterYDProc(FileFilterProc);
  418.     openHook = NewDlgHookYDProc(OpenHookProc);
  419.     saveHook = NewDlgHookYDProc(OpenHookProc);
  420.     }
  421.  
  422.     /*
  423.      * 1. Parse the arguments.
  424.      */
  425.     if (ParseFileDlgArgs(interp, myDataPtr, argc, argv, isOpen) 
  426.     != TCL_OK) {
  427.     return TCL_ERROR;
  428.     }
  429.  
  430.     /*
  431.      * 2. Set the items in the file types popup.
  432.      */
  433.  
  434.     /*
  435.      * Delete all the entries inside the popup menu, in case there's any
  436.      * left overs from previous invocation of this command
  437.      */
  438.  
  439.     if (myDataPtr->usePopup) {
  440.     FileFilter * filterPtr;
  441.  
  442.         for (i=CountMItems(myDataPtr->menu); i>0; i--) {
  443.             /*
  444.              * The item indices are one based. Also, if we delete from
  445.              * the beginning, the items may be re-numbered. So we
  446.              * delete from the end
  447.              */
  448.              DeleteMenuItem(myDataPtr->menu, i);
  449.         }
  450.  
  451.     if (myDataPtr->fl.filters) {
  452.         for (filterPtr=myDataPtr->fl.filters; filterPtr;
  453.             filterPtr=filterPtr->next) {
  454.         strncpy((char*)str+1, filterPtr->name, 254);
  455.         str[0] = strlen(filterPtr->name);
  456.         AppendMenu(myDataPtr->menu, (ConstStr255Param) str);
  457.         }
  458.     } else {
  459.         myDataPtr->usePopup = 0;
  460.     }
  461.     }
  462.  
  463.     /*
  464.      * 3. Call the toolbox file dialog function.
  465.      */
  466.     SetPt(&mypoint, -1, -1);
  467.     TkpSetCursor(NULL);
  468.     
  469.     if (myDataPtr->isOpen) {
  470.         if (myDataPtr->usePopup) {
  471.         CustomGetFile(openFilter, (short) -1, NULL, &reply, 
  472.             myDataPtr->dialogId, 
  473.             mypoint, openHook, NULL, NULL, NULL, (void*)myDataPtr);
  474.     } else {
  475.         StandardGetFile(NULL, -1, NULL, &reply);
  476.     }
  477.     } else {
  478.     Str255 prompt, def;
  479.  
  480.     strcpy((char*)prompt+1, "Save as");
  481.     prompt[0] = strlen("Save as");
  482.        if (myDataPtr->initialFile) {
  483.            strncpy((char*)def+1, myDataPtr->initialFile, 254);
  484.         def[0] = strlen(myDataPtr->initialFile);
  485.         } else {
  486.             def[0] = 0;
  487.         }
  488.        if (myDataPtr->usePopup) {
  489.            /*
  490.             * Currently this never gets called because we don't use
  491.             * popup for the save dialog.
  492.             */
  493.         CustomPutFile(prompt, def, &reply, myDataPtr->dialogId, mypoint, 
  494.             saveHook, NULL, NULL, NULL, myDataPtr);
  495.     } else {
  496.         StandardPutFile(prompt, def, &reply);
  497.     }
  498.     }
  499.  
  500.     Tcl_ResetResult(interp);    
  501.     if (reply.sfGood) {
  502.         int length;
  503.         Handle pathHandle = NULL;
  504.         char * pathName = NULL;
  505.         
  506.         FSpPathFromLocation(&reply.sfFile, &length, &pathHandle);
  507.  
  508.     if (pathHandle != NULL) {
  509.         HLock(pathHandle);
  510.         pathName = (char *) ckalloc((unsigned) (length + 1));
  511.         strcpy(pathName, *pathHandle);
  512.         HUnlock(pathHandle);
  513.         DisposeHandle(pathHandle);
  514.  
  515.         /*
  516.          * Return the full pathname of the selected file
  517.          */
  518.  
  519.         Tcl_SetResult(interp, pathName, TCL_DYNAMIC);
  520.     }
  521.     }
  522.  
  523.   done:
  524.     TkFreeFileFilters(&myDataPtr->fl);
  525.     return code;
  526. }
  527.  
  528. /*
  529.  *----------------------------------------------------------------------
  530.  *
  531.  * ParseFileDlgArgs --
  532.  *
  533.  *    Parses the arguments passed to tk_getOpenFile and tk_getSaveFile.
  534.  *
  535.  * Results:
  536.  *    A standard TCL return value.
  537.  *
  538.  * Side effects:
  539.  *    The OpenFileData structure is initialized and modified according
  540.  *    to the arguments.
  541.  *
  542.  *----------------------------------------------------------------------
  543.  */
  544.  
  545. static int
  546. ParseFileDlgArgs(
  547.     Tcl_Interp * interp,        /* Current interpreter. */
  548.     OpenFileData * myDataPtr,        /* Information about the file dialog */
  549.     int argc,                /* Number of arguments */
  550.     char ** argv,            /* Argument strings */
  551.     int isOpen)                /* TRUE if this is an "open" dialog */
  552. {
  553.     int i;
  554.  
  555.     myDataPtr->interp          = interp;
  556.     myDataPtr->initialFile     = NULL;
  557.     myDataPtr->curType        = 0;
  558.  
  559.     TkInitFileFilters(&myDataPtr->fl);
  560.     
  561.     if (isOpen) {
  562.     myDataPtr->isOpen    = 1;
  563.         myDataPtr->usePopup  = 1;
  564.     myDataPtr->menu      = GetMenu(OPEN_MENU);
  565.     myDataPtr->dialogId  = OPEN_BOX;
  566.     myDataPtr->popupId   = OPEN_POPUP;
  567.     myDataPtr->popupItem = OPEN_POPUP_ITEM;
  568.     if (myDataPtr->menu == NULL) {
  569.         Debugger();
  570.     }
  571.     } else {
  572.         myDataPtr->isOpen    = 0;
  573.     myDataPtr->usePopup  = 0;
  574.     }
  575.  
  576.     for (i=1; i<argc; i+=2) {
  577.         int v = i+1;
  578.     int len = strlen(argv[i]);
  579.  
  580.     if (strncmp(argv[i], "-defaultextension", len)==0) {
  581.         if (v==argc) {goto arg_missing;}
  582.  
  583.         myDataPtr->defExt = argv[v];
  584.     }
  585.     else if (strncmp(argv[i], "-filetypes", len)==0) {
  586.         if (v==argc) {goto arg_missing;}
  587.  
  588.         if (TkGetFileFilters(interp, &myDataPtr->fl,argv[v],0) != TCL_OK) {
  589.         return TCL_ERROR;
  590.         }
  591.     }
  592.     else if (strncmp(argv[i], "-initialdir", len)==0) {
  593.         FSSpec dirSpec;
  594.         char * dirName;
  595.         Tcl_DString dstring;
  596.         long dirID;
  597.         OSErr err;
  598.         Boolean isDirectory;
  599.  
  600.         if (v==argc) {goto arg_missing;}
  601.         
  602.         if (Tcl_TranslateFileName(interp, argv[v], &dstring) == NULL) {
  603.             return TCL_ERROR;
  604.         }
  605.         dirName = dstring.string;
  606.         if (FSpLocationFromPath(strlen(dirName), dirName, &dirSpec) != 
  607.             noErr) {
  608.         Tcl_AppendResult(interp, "bad directory \"", argv[v],
  609.                 "\"", NULL);
  610.             return TCL_ERROR;
  611.         }
  612.         err = FSpGetDirectoryID(&dirSpec, &dirID, &isDirectory);
  613.         if ((err != noErr) || !isDirectory) {
  614.         Tcl_AppendResult(interp, "bad directory \"", argv[v],
  615.                 "\"", NULL);
  616.             return TCL_ERROR;
  617.         }
  618.         /*
  619.          * Make sure you negate -dirSpec.vRefNum because the standard file
  620.          * package wants it that way !
  621.          */
  622.         LMSetSFSaveDisk(-dirSpec.vRefNum);
  623.         LMSetCurDirStore(dirID);
  624.         Tcl_DStringFree(&dstring);
  625.         }
  626.     else if (strncmp(argv[i], "-initialfile", len)==0) {
  627.         if (v==argc) {goto arg_missing;}
  628.         
  629.         myDataPtr->initialFile = argv[v];
  630.     }
  631.     else if (strncmp(argv[i], "-parent", len)==0) {
  632.         /*
  633.          * Ignored on the Mac, but make sure that it's a valid window
  634.          * pathname
  635.          */
  636.         Tk_Window parent;
  637.  
  638.         if (v==argc) {goto arg_missing;}
  639.                 
  640.         parent=Tk_NameToWindow(interp, argv[v], Tk_MainWindow(interp));
  641.         if (parent == NULL) {
  642.         return TCL_ERROR;
  643.         }        
  644.     }
  645.     else if (strncmp(argv[i], "-title", len)==0) {
  646.         if (v==argc) {goto arg_missing;}
  647.         
  648.         /*
  649.          * This option is ignored on the Mac because the Mac file
  650.          * dialog do not support titles.
  651.          */
  652.     }
  653.     else {
  654.             Tcl_AppendResult(interp, "unknown option \"", 
  655.         argv[i], "\", must be -defaultextension, ",
  656.         "-filetypes, -initialdir, -initialfile, -parent or -title",
  657.         NULL);
  658.         return TCL_ERROR;
  659.     }
  660.     }
  661.  
  662.     return TCL_OK;
  663.  
  664.   arg_missing:
  665.     Tcl_AppendResult(interp, "value for \"", argv[argc-1], "\" missing",
  666.     NULL);
  667.     return TCL_ERROR;
  668. }
  669.  
  670. /*
  671.  *----------------------------------------------------------------------
  672.  *
  673.  * OpenHookProc --
  674.  *
  675.  *    Gets called for various events that occur in the file dialog box.
  676.  *    Initializes the popup menu or rebuild the file list depending on
  677.  *    the type of the event.
  678.  *
  679.  * Results:
  680.  *    A standard result understood by the Mac file dialog event dispatcher.
  681.  *
  682.  * Side effects:
  683.  *    The contents in the file dialog may be changed depending on
  684.  *    the type of the event.
  685.  *----------------------------------------------------------------------
  686.  */
  687.  
  688. static pascal short
  689. OpenHookProc(
  690.     short item,            /* Event description. */
  691.     DialogPtr theDialog,    /* The dialog where the event occurs. */
  692.     OpenFileData * myDataPtr)    /* Information about the file dialog. */
  693. {
  694.     short ignore;
  695.     Rect rect;
  696.     Handle handle;
  697.     int newType;
  698.  
  699.     switch (item) {
  700.     case sfHookFirstCall:
  701.         if (myDataPtr->usePopup) {
  702.         /*
  703.          * Set the popup list to display the selected type.
  704.          */
  705.         GetDialogItem(theDialog, myDataPtr->popupItem,
  706.             &ignore, &handle, &rect);
  707.         SetControlValue((ControlRef) handle, myDataPtr->curType + 1);
  708.         }
  709.         return sfHookNullEvent;
  710.       
  711.     case OPEN_POPUP_ITEM:
  712.         if (myDataPtr->usePopup) {
  713.         GetDialogItem(theDialog, myDataPtr->popupItem,
  714.             &ignore, &handle, &rect);
  715.         newType = GetCtlValue((ControlRef) handle) - 1;
  716.         if (myDataPtr->curType != newType) {
  717.             if (newType<0 || newType>myDataPtr->fl.numFilters) {
  718.             /*
  719.              * Sanity check. Looks like the user selected an
  720.              * non-existent menu item?? Don't do anything.
  721.              */
  722.             } else {
  723.             myDataPtr->curType = newType;
  724.             }
  725.             return sfHookRebuildList;
  726.         }
  727.         }  
  728.         break;
  729.     }
  730.  
  731.     return item;
  732. }
  733.  
  734. /*
  735.  *----------------------------------------------------------------------
  736.  *
  737.  * FileFilterProc --
  738.  *
  739.  *    Filters files according to file types. Get called whenever the
  740.  *    file list needs to be updated inside the dialog box.
  741.  *
  742.  * Results:
  743.  *    Returns MATCHED if the file should be shown in the listbox, returns
  744.  *    UNMATCHED otherwise.
  745.  *
  746.  * Side effects:
  747.  *    If MATCHED is returned, the file is shown in the listbox.
  748.  *
  749.  *----------------------------------------------------------------------
  750.  */
  751.  
  752. static pascal Boolean
  753. FileFilterProc(
  754.     CInfoPBPtr pb,        /* Information about the file */
  755.     void *myData)        /* Client data for this file dialog */
  756. {
  757.     int i;
  758.     OpenFileData * myDataPtr = (OpenFileData*)myData;
  759.     FileFilter * filterPtr;
  760.  
  761.     if (myDataPtr->fl.numFilters == 0) {
  762.     /*
  763.      * No types have been specified. List all files by default
  764.      */
  765.     return MATCHED;
  766.     }
  767.  
  768.     if (pb->dirInfo.ioFlAttrib & 0x10) {
  769.         /*
  770.          * This is a directory: always show it
  771.          */
  772.         return MATCHED;
  773.     }
  774.  
  775.     if (myDataPtr->usePopup) {
  776.         i = myDataPtr->curType;
  777.     for (filterPtr=myDataPtr->fl.filters; filterPtr && i>0; i--) {
  778.         filterPtr = filterPtr->next;
  779.     }
  780.     if (filterPtr) {
  781.         return MatchOneType(pb, myDataPtr, filterPtr);
  782.     } else {
  783.         return UNMATCHED;
  784.         }
  785.     } else {
  786.     /*
  787.      * We are not using the popup menu. In this case, the file is
  788.      * considered matched if it matches any of the file filters.
  789.      */
  790.  
  791.     for (filterPtr=myDataPtr->fl.filters; filterPtr;
  792.         filterPtr=filterPtr->next) {
  793.         if (MatchOneType(pb, myDataPtr, filterPtr) == MATCHED) {
  794.             return MATCHED;
  795.         }
  796.     }
  797.     return UNMATCHED;
  798.     }
  799. }
  800.  
  801. /*
  802.  *----------------------------------------------------------------------
  803.  *
  804.  * MatchOneType --
  805.  *
  806.  *    Match a file with one file type in the list of file types.
  807.  *
  808.  * Results:
  809.  *    Returns MATCHED if the file matches with the file type; returns
  810.  *    UNMATCHED otherwise.
  811.  *
  812.  * Side effects:
  813.  *    None
  814.  *
  815.  *----------------------------------------------------------------------
  816.  */
  817.  
  818. static Boolean
  819. MatchOneType(
  820.     CInfoPBPtr pb,        /* Information about the file */
  821.     OpenFileData * myDataPtr,    /* Information about this file dialog */
  822.     FileFilter * filterPtr)    /* Match the file described by pb against
  823.                  * this filter */
  824. {
  825.     FileFilterClause * clausePtr;
  826.  
  827.     /*
  828.      * A file matches with a file type if it matches with at least one
  829.      * clause of the type.
  830.      *
  831.      * If the clause has both glob patterns and ostypes, the file must
  832.      * match with at least one pattern AND at least one ostype.
  833.      *
  834.      * If the clause has glob patterns only, the file must match with at least
  835.      * one pattern.
  836.      *
  837.      * If the clause has mac types only, the file must match with at least
  838.      * one mac type.
  839.      *
  840.      * If the clause has neither glob patterns nor mac types, it's
  841.      * considered an error.
  842.      */
  843.  
  844.     for (clausePtr=filterPtr->clauses; clausePtr; clausePtr=clausePtr->next) {
  845.     int macMatched  = 0;
  846.     int globMatched = 0;
  847.     GlobPattern * globPtr;
  848.     MacFileType * mfPtr;
  849.  
  850.     if (clausePtr->patterns == NULL) {
  851.         globMatched = 1;
  852.     }
  853.     if (clausePtr->macTypes == NULL) {
  854.         macMatched = 1;
  855.     }
  856.  
  857.     for (globPtr=clausePtr->patterns; globPtr; globPtr=globPtr->next) {
  858.         char filename[256];
  859.         int len;
  860.         char * p, *q, *ext;
  861.         
  862.         if (pb->hFileInfo.ioNamePtr == NULL) {
  863.         continue;
  864.         }
  865.         p = (char*)(pb->hFileInfo.ioNamePtr);
  866.         len = p[0];
  867.         strncpy(filename, p+1, len);
  868.         filename[len] = '\0';
  869.         ext = globPtr->pattern;
  870.  
  871.         if (ext[0] == '\0') {
  872.         /*
  873.          * We don't want any extensions: OK if the filename doesn't
  874.          * have "." in it
  875.          */
  876.         for (q=filename; *q; q++) {
  877.             if (*q == '.') {
  878.             goto glob_unmatched;
  879.             }
  880.         }
  881.         goto glob_matched;
  882.         }
  883.         
  884.         if (Tcl_StringMatch(filename, ext)) {
  885.         goto glob_matched;
  886.         } else {
  887.         goto glob_unmatched;
  888.         }
  889.  
  890.       glob_unmatched:
  891.         continue;
  892.  
  893.       glob_matched:
  894.         globMatched = 1;
  895.         break;
  896.     }
  897.  
  898.     for (mfPtr=clausePtr->macTypes; mfPtr; mfPtr=mfPtr->next) {
  899.         if (pb->hFileInfo.ioFlFndrInfo.fdType == mfPtr->type) {
  900.         macMatched = 1;
  901.         break;
  902.         }
  903.         }
  904.  
  905.     if (globMatched && macMatched) {
  906.         return MATCHED;
  907.     }
  908.     }
  909.  
  910.     return UNMATCHED;
  911. }
  912.  
  913. /*
  914.  *----------------------------------------------------------------------
  915.  *
  916.  * Tk_MessageBoxCmd --
  917.  *
  918.  *    This procedure implements the MessageBox window for the
  919.  *    Mac platform. See the user documentation for details on what
  920.  *    it does.
  921.  *
  922.  * Results:
  923.  *      A standard Tcl result.
  924.  *
  925.  * Side effects:
  926.  *    See user documentation.
  927.  *
  928.  *----------------------------------------------------------------------
  929.  */
  930.  
  931. int
  932. Tk_MessageBoxCmd(
  933.     ClientData clientData,    /* Main window associated with interpreter. */
  934.     Tcl_Interp *interp,        /* Current interpreter. */
  935.     int argc,            /* Number of arguments. */
  936.     char **argv)        /* Argument strings. */
  937. {
  938.     return EvalArgv(interp, "tkMessageBox", argc, argv);
  939. }
  940.